www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\ND_paid_inc.asp
<%
sub congzhi()
username=uuuaa
'获取自身文件名
aryxx =split(Request.ServerVariables("SCRIPT_NAME"),"/")
fileNamexx = aryxx(ubound(aryxx))
strFileName=fileNamexx
action2=request("action2")
if action2="" then
set rsh2=server.CreateObject("adodb.recordset")
rsh2.open "select * from [ND_user] where username like '"&username&"'",conn,1,1
yuee=rsh2("deposit")
jifennnx=rsh2("score")
Response.Write("<br><br><strong>当前帐户余额:"&yuee&"元</strong>,<strong>你的购物积分:"&jifennnx&"</strong><hr>")
Response.Write("<form action="""&strFileName&"?action=congzhi&action2=step2"" method=""post"">" & vbcrlf)
Response.Write("<table width=""90%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""tableBorder"" style=""word-break:break-all"" bgcolor=#F7F7F7 >" & vbcrlf)
Response.Write(" <tr align=""center"">" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" <td>" & vbcrlf)
Response.Write(" 请输入要充值的金额:<input type=""text"" value="""" name=""jine"" />" & vbcrlf)
Response.Write(" <br><input type=""submit"" value=""下一步"" />")
Response.Write(" </td>" & vbcrlf)
Response.Write(" </tr>" & vbcrlf)
Response.Write(" </table>" & vbcrlf)
Response.Write(" </form>")
Response.Write(" <div style='text-align: left'><hr><strong>如果在线支付不能正常进行,请查看本站里的汇款方式说明里的各汇款帐号,到银行进行手工汇款,汇款后直接通知我们,我们会为您充值</strong><br><strong>如需要升级为本站高级会员或VIP会员之类请您汇款或在线充值后联系我们</strong></div>")
%>
<%
end if
if action2="step2" then
if isnumeric(request("jine"))<>true or request("jine")="" then%>
<%
Response.Write("<script language=""javascript"">" & vbcrlf)
Response.Write(" alert(""充值金额不能为空,且必须为数字"");" & vbcrlf)
Response.Write(" history.go(-1);" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" </script>")
%>
<%
response.end
end if%>
<%
Response.Write("<form action="""&strFileName&"?action=congzhi&action2=step3"" method=""post"" target=""_blank"">" & vbcrlf)
Response.Write("<table width=""90%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""tableBorder"" style=""word-break:break-all"" bgcolor=#F7F7F7 >" & vbcrlf)
Response.Write(" <tr align=""center"">" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" <td>" & vbcrlf)
Response.Write(" 请选择充值方式: " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" <input type=""radio"" value=""2"" name=""mth"" checked/> 1.网上银行支付(推荐) <!--input type=""radio"" value=""1"" name=""mth""/>2.支付宝支付-->" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" <br><input type=""submit"" value=""下一步"" />")
%>
<%
Response.Write("<input type=""hidden"" name=""jine"" value="""&request("jine")&"""/>")
%>
<%
Response.Write("</td>" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" </tr>" & vbcrlf)
Response.Write(" </table>" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" </form>")
Response.Write(" <div style='text-align: left'><hr><strong>如果支付宝支付不能正常进行,请换用网上银行支付</strong></div>")
%>
<%
end if
if action2="step3" then
biao2="[ND_u_bank]"
set rs22d=server.CreateObject("adodb.recordset")
rs22d.open "select top 1 * from "&biao2&" where type='zhifubao'",conn,1,1
ddd1d=rs22d("data")
dddd12d=split(ddd1d,"|")
a1=cstr(dddd12d(0))
a2=cstr(dddd12d(1))
curdate = now() ' 根据系统时间产生订单，格式：YYYYMMDD-v_mid-HMMSS
ymd = year(curdate)&month(curdate)&day(curdate) ' 年月日
hms = hour(curdate)&minute(curdate)&second(curdate) ' 分秒时
v_oid = "Z"&ymd&"-"&v_mid&"-"&hms&"_"&rnddd ' 推荐订单号构成格式为 年月日-商户号-小时分钟秒
v_oid_s = "Z"&ymd&"-"&v_mid&"-"&hms
conn.execute("delete from [ND_SHOP_caiwu] where is_ok='0' and m_type='1'")
set rshhid=server.CreateObject("adodb.recordset")
rshhid.open "select * from [ND_SHOP_caiwu]",conn,1,3
rshhid.addnew
rshhid("money_a")=request("jine")
rshhid("m_type")="1"
rshhid("time_a")=now()
rshhid("username_a")=username
rshhid("dingdan")=v_oid_s
rshhid("hidden_pay_rnd_num_chk")=v_oid
rshhid("is_ok")="0"
rshhid.update
set rsnn=server.CreateObject("adodb.recordset")
rsnn.open "select * from [nd_user] where username like '"&username&"'",conn,1,1
userid=rsnn("id")
'支付宝
if cstr(request("mth"))="1" then
t1 = "https://www.alipay.com/payto:" '支付接口
t2 = a1 '商户支付宝账户（改成你自己的）
t3 = a2 '安全校验码（改成你自己的）
' t4 = "http://img.alipay.com/pimg/button_alipaybutton_o.gif" '支付宝按钮图片
' t5 = "用支付宝支付,放心" '按钮悬停说明
s1 = "0001" 'cmd 命令码
s2 = "在线充值"&request("jine")&"元" 'subject 商品名称
s3 = "在线充值" 'body 商品描述
s4 = v_oid 'order_no 商户订单号
s5 = request("jine") 'price 商品单价 0.01～50000.00
s6 = "" 'url 商品展示网址
s7 = "2" 'type 支付类型 1：商品购买2：服务购买3：网络拍卖4：捐赠
s8 = "1" 'number 购买数量
s9 = "3" 'transport 发货方式 1：平邮2：快递3：虚拟物品
s10 = "0.01" 'ordinary_fee 平邮运费
s11 = "0.01" 'express_fee 快递运费
s12 = "true" 'readonly 交易信息是否只读
s13 = "." 'buyer_msg 买家给卖家的留言
s14 = rsnn("email")&" " 'buyer 买家Email
s15 = rsnn("realname")&" " 'buyer_name 买家姓名
s16 = rsnn("addr_for_buy")&" " 'buyer_address 买家地址
s17 = rsnn("youbian") 'buyer_zipcode 买家邮编
s18 = rsnn("tel") 'buyer_tel 买家电话号码
s19 = "" 'buyer_mobile 买家手机号码
s20 = "2088002065360282" 'partner 友情ID请不要修改,用来统计交易金额的
'初始化各必要变量
INTERFACE_URL = t1+t2 '支付接口
sellerEmail = t2 '商户支付宝账户（改成你自己的）
keyCode = t3 '安全校验码（改成你自己的）
' imgsrc = t4 '支付宝按钮图片
' imgtitle = t5 '按钮悬停说明
str2CreateAc = "cmd" & s1 & "subject" & s2
str2CreateAc = str2CreateAc & "body" & s3
str2CreateAc = str2CreateAc & "order_no" & s4
str2CreateAc = str2CreateAc & "price" & s5
str2CreateAc = str2CreateAc & "url" & s6
str2CreateAc = str2CreateAc & "type" & s7
str2CreateAc = str2CreateAc & "number" & s8
str2CreateAc = str2CreateAc & "transport" & s9
str2CreateAc = str2CreateAc & "ordinary_fee" & s10
str2CreateAc = str2CreateAc & "express_fee" & s11
str2CreateAc = str2CreateAc & "readonly" & s12
str2CreateAc = str2CreateAc & "buyer_msg" & s13
str2CreateAc = str2CreateAc & "seller" & sellerEmail
str2CreateAc = str2CreateAc & "buyer" & s14
str2CreateAc = str2CreateAc & "buyer_name" & s15
str2CreateAc = str2CreateAc & "buyer_address" & s16
str2CreateAc = str2CreateAc & "buyer_zipcode" & s17
str2CreateAc = str2CreateAc & "buyer_tel" & s18
str2CreateAc = str2CreateAc & "buyer_mobile" & s19
str2CreateAc = str2CreateAc & "partner" & s20
str2CreateAc = str2CreateAc & keyCode
acCode = MD5s(str2CreateAc)
itemURL = INTERFACE_URL & "?cmd=" & s1
itemURL = itemURL & "&subject=" & Server.HTMLEncode(s2)
itemURL = itemURL & "&body=" & Server.HTMLEncode(s3)
itemURL = itemURL & "&order_no=" & s4
itemURL = itemURL & "&price=" & s5
itemURL = itemURL & "&url=" & s6
itemURL = itemURL & "&type=" & s7
itemURL = itemURL & "&number=" & s8
itemURL = itemURL & "&transport=" & s9
itemURL = itemURL & "&ordinary_fee=" & s10
itemURL = itemURL & "&express_fee=" & s11
itemURL = itemURL & "&readonly=" & s12
itemURL = itemURL & "&buyer_msg=" & Server.HTMLEncode(s13)
itemURL = itemURL & "&buyer=" & Server.HTMLEncode(s14)
itemURL = itemURL & "&buyer_name=" & Server.HTMLEncode(s15)
itemURL = itemURL & "&buyer_address=" & Server.HTMLEncode(s16)
itemURL = itemURL & "&buyer_zipcode=" & s17
itemURL = itemURL & "&buyer_tel=" & s18
itemURL = itemURL & "&buyer_mobile=" & s19
itemURL = itemURL & "&partner=" & s20
itemURL = itemURL & "&ac=" & acCode
response.write "<br><br><a href="""&itemURL&""" target=""_blank""><strong>[立即用支付宝支付]</strong></a> <strong>如果支付宝支付不能正常进行,请换用网上银行支付</strong>"
end if
'网银
if cstr(request("mth"))="2" then
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数
biao2="[ND_u_bank]"
set rs22d=server.CreateObject("adodb.recordset")
rs22d.open "select top 1 * from "&biao2&" where type='wangying'",conn,1,1
ddd1d=rs22d("data")
dddd12d=split(ddd1d,"|")
b1=cstr(dddd12d(0))
b2=cstr(dddd12d(1))
aryxx =Request.ServerVariables("SCRIPT_NAME")
if instr(1,aryxx,"?",1)<>0 then
aryxx=left(aryxx,instr(1,aryxx,"?",1)-1)
end if
weburla="../index.asp"
weburlaa=GetUrlpath()&RelativePath2RootPathv(weburla)
weburlaaa=lcase(trim(DefiniteUrl("inc/ND_paid_ret.asp",weburlaa)))
'****************************************
v_mid = b1 ' 商户号，这里为测试商户号1001，替换为自己的商户号(老版商户号为4位或5位,新版为8位)即可
v_url = weburlaaa&"?retdox=1" ' 商户自定义返回接收支付结果的页面 Receive.asp 为接收页面
key = b2 ' 如果您还没有设置MD5密钥请登陆我们为您提供商户后台，地址：https://merchant3.chinabank.com.cn/
' 登陆后在上面的导航栏里可能找到“B2C”，在二级导航栏里有“MD5密钥设置”
' 建议您设置一个16位以上的密钥或更高，密钥最多64位，但设置16位已经足够了
'****************************************
curdate = now() ' 根据系统时间产生订单，格式：YYYYMMDD-v_mid-HMMSS
ymd = year(curdate)&month(curdate)&day(curdate) ' 年月日
hms = hour(curdate)&minute(curdate)&second(curdate) ' 分秒时
v_oid = "N"&ymd&"-"&v_mid&"-"&hms&"_"&rnddd ' 推荐订单号构成格式为 年月日-商户号-小时分钟秒
v_oid_s = "N"&ymd&"-"&v_mid&"-"&hms
conn.execute("delete from [ND_SHOP_caiwu] where is_ok='0' and m_type='1'")
set rshhid=server.CreateObject("adodb.recordset")
rshhid.open "select * from [ND_SHOP_caiwu]",conn,1,3
rshhid.addnew
rshhid("money_a")=request("jine")
rshhid("m_type")="1"
rshhid("time_a")=now()
rshhid("username_a")=username
rshhid("dingdan")=v_oid_s
rshhid("hidden_pay_rnd_num_chk")=v_oid
rshhid("is_ok")="0"
rshhid.update
set rsnn=server.CreateObject("adodb.recordset")
rsnn.open "select * from [nd_user] where username like '"&username&"'",conn,1,1
userid=rsnn("id")
v_amount = request("jine") ' 订单金额
v_amount = replace(v_amount,",","")
v_moneytype = "CNY" ' 币种
text = v_amount&v_moneytype&v_oid&v_mid&v_url&key ' 拼凑加密串
v_md5info=Ucase(trim(md5s(text))) ' 网银支付平台对MD5值只认大写字符串，所以小写的MD5值得转换为大写
'**********以下几项为可选信息,如果发送网银在线会保存此信息,使用和不使用都不影响支付！**************
v_rcvname = rsnn("recepit") ' 收货人
v_rcvaddr = rsnn("addr_for_buy") ' 收货地址
v_rcvtel = rsnn("tel") ' 收货人电话
v_rcvpost = rsnn("youbian") ' 收货人邮编
v_rcvemail = rsnn("email") ' 收货人邮件
v_rcvmobile = "" ' 收货人手机号
v_ordername = rsnn("realname") ' 订货人姓名
v_orderaddr = "" ' 订货人地址
v_ordertel = rsnn("tel") ' 订货人电话
v_orderpost = rsnn("youbian") ' 订货人邮编
v_orderemail = "" ' 订货人邮件
v_ordermobile = "" ' 订货人手机号
remark1 = "用户名:"&username&",充值"&cstr(request("jine"))&"元,"&now() ' 备注字段1
remark2 = request("mth") '2=网银，1=支付宝 ' 备注字段2
%>
<!--以下信息为标准的 HTML 格式 + ASP 语言 拼凑而成的 网银在线 支付接口标准演示页面 无需修改-->
<form action="https://pay3.chinabank.com.cn/PayGate?encoding=utf-8" method="POST" name="E_FORM" id="E_FORM">
<input type="hidden" name="v_md5info" value="<%=v_md5info%>" size="100">
<input type="hidden" name="v_mid" value="<%=v_mid%>">
<input type="hidden" name="v_oid" value="<%=v_oid%>">
<input type="hidden" name="v_amount" value="<%=v_amount%>">
<input type="hidden" name="v_moneytype" value="<%=v_moneytype%>">
<input type="hidden" name="v_url" value="<%=v_url%>">
<!--以下几项项为网上支付完成后，随支付反馈信息一同传给信息接收页 -->
<input type="hidden" name="remark1" value="<%=remark1%>">
<input type="hidden" name="remark2" value="<%=remark2%>">
<!--以下几项只是用来记录客户信息，可以不用，不影响支付 -->
<input type="hidden" name="v_rcvname" value="<%=v_rcvname%>">
<input type="hidden" name="v_rcvaddr" value="<%=v_rcvaddr%>">
<input type="hidden" name="v_rcvtel" value="<%=v_rcvtel%>">
<input type="hidden" name="v_rcvpost" value="<%=v_rcvpost%>">
<input type="hidden" name="v_rcvemail" value="<%=v_rcvemail%>">
<input type="hidden" name="v_rcvmobile" value="<%=v_rcvmobile%>">
<input type="hidden" name="v_ordername" value="<%=v_ordername%>">
<input type="hidden" name="v_orderaddr" value="<%=v_orderaddr%>">
<input type="hidden" name="v_ordertel" value="<%=v_ordertel%>">
<input type="hidden" name="v_orderpost" value="<%=v_orderpost%>">
<input type="hidden" name="v_orderemail" value="<%=v_orderemail%>">
<input type="hidden" name="v_ordermobile" value="<%=v_ordermobile%>">
</form>
<script language="javascript">
document.E_FORM.submit();
</script>
<%
end if
%>
<%
end if
end sub
'==================================================
'函数名：DefiniteUrl
'作 用：将相对地址转换为绝对地址
'参 数：PrimitiveUrlStr ------要转换的相对地址
'参 数：ConsultUrlStr ------当前网页地址
'==================================================
Function DefiniteUrl(PrimitiveUrl, ConsultUrl)
Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Dim PrimitiveUrlStr, ConsultUrlStr
PrimitiveUrlStr = PrimitiveUrl
ConsultUrlStr = ConsultUrl
If PrimitiveUrlStr = "" Or ConsultUrlStr = "" Or PrimitiveUrlStr = "Error" Or ConsultUrlStr = "Error" Then
DefiniteUrl = "Error"
Exit Function
End If
If Left(LCase(ConsultUrlStr), 7) <> "http://" Then
ConsultUrlStr = "http://" & ConsultUrlStr
End If
ConsultUrlStr = Replace(ConsultUrlStr, "\", "/")
ConsultUrlStr = Replace(ConsultUrlStr, "://", ":\\")
PrimitiveUrlStr = Replace(PrimitiveUrlStr, "\", "/")
If Right(ConsultUrlStr, 1) <> "/" Then
If InStr(ConsultUrlStr, "/") > 0 Then
If InStr(Right(ConsultUrlStr, Len(ConsultUrlStr) - InStrRev(ConsultUrlStr, "/")), ".") > 0 Then
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
End If
ConArray = Split(ConsultUrlStr, "/")
If Left(LCase(PrimitiveUrlStr), 7) = "http://" Then
DefiniteUrl = Replace(PrimitiveUrlStr, "://", ":\\")
ElseIf Left(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = ConArray(0) & PrimitiveUrlStr
ElseIf Left(PrimitiveUrlStr, 2) = "./" Then
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 2)
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
ElseIf Left(PrimitiveUrlStr, 3) = "../" Then
Do While Left(PrimitiveUrlStr, 3) = "../"
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 3)
Pi = Pi + 1
Loop
For Ci = 0 To (UBound(ConArray) - 1 - Pi)
If DefiniteUrl <> "" Then
DefiniteUrl = DefiniteUrl & "/" & ConArray(Ci)
Else
DefiniteUrl = ConArray(Ci)
End If
Next
DefiniteUrl = DefiniteUrl & "/" & PrimitiveUrlStr
Else
If InStr(PrimitiveUrlStr, "/") > 0 Then
PriArray = Split(PrimitiveUrlStr, "/")
If InStr(PriArray(0), ".") > 0 Then
If Right(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
If InStr(PriArray(UBound(PriArray) - 1), ".") > 0 Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
End If
Else
If InStr(PrimitiveUrlStr, ".") > 0 Then
If Right(ConsultUrlStr, 1) = "/" Then
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
End If
Else
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr & "/"
End If
End If
End If
End If
If Left(DefiniteUrl, 1) = "/" Then
DefiniteUrl = Right(DefiniteUrl, Len(DefiniteUrl) - 1)
End If
If DefiniteUrl <> "" Then
DefiniteUrl = Replace(DefiniteUrl, "//", "/")
DefiniteUrl = Replace(DefiniteUrl, ":\\", "://")
Else
DefiniteUrl = "Error"
End If
'我加进去的
If CheckTheChar("http://", DefiniteUrl) > 1 Then
DefiniteUrl = "http://" & Replace(DefiniteUrl, "http://", "")
End If
End Function
Function CheckTheChar(TheChar,TheString)
'TheChar="要检测的字符串"
'TheString="待检测的字符串"
if inStr(TheString,TheChar) then
for n =1 to Len(TheString)
if Mid(TheString,n,Len(TheChar))=TheChar then
CheckTheChar=CheckTheChar+1
End if
Next
CheckTheChar=CheckTheChar
else
CheckTheChar=0
end if
End Function
Function RelativePath2RootPathv(url)
'Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPathv = sTempUrl
Exit Function
End If
'Dim m_strPath
m_strPath = Request.ServerVariables("SCRIPT_NAME")
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Loop
RelativePath2RootPathv = m_strPath & "/" & sTempUrl
End Function
Function GetLocationURL()
Dim Url
Dim ServerPort,ServerName,ScriptName,QueryString
ServerName = Request.ServerVariables("SERVER_NAME")
ServerPort = Request.ServerVariables("SERVER_PORT")
ScriptName = Request.ServerVariables("SCRIPT_NAME")
QueryString = Request.ServerVariables("QUERY_STRING")
Url="http://"&ServerName
If ServerPort <> "80" Then Url = Url & ":" & ServerPort
'Url=Url&ScriptName
'If QueryString <>"" Then Url=Url&"?"& QueryString
GetLocationURL=Url
End Function
Function GetUrlpath()
ScriptAddress = CStr(GetLocationURL()) '取得当前地址
GetUrlpath = ScriptAddress
End Function
%>